Preparação dos Dados

Carregamento dos Dados

# Ler arquivo csv
Vinhos <- read.csv2("BaseWine_Red_e_White2018.csv", row.names=1)

#mostrar as variáveis e alguns valores
str(Vinhos)
## 'data.frame':    6497 obs. of  13 variables:
##  $ fixedacidity      : num  6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
##  $ volatileacidity   : num  0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
##  $ citricacid        : num  0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
##  $ residualsugar     : num  7.7 1.6 2.2 4.8 18.8 ...
##  $ chlorides         : num  0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
##  $ freesulfurdioxide : num  36 29 18 30 65 16 4 34 46 58 ...
##  $ totalsulfurdioxide: num  135 114 40 113 224 49 8 102 113 184 ...
##  $ density           : num  0.994 0.99 0.998 0.994 1 ...
##  $ pH                : num  3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
##  $ sulphates         : num  0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
##  $ alcohol           : num  10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
##  $ quality           : int  5 6 6 6 5 5 4 6 7 6 ...
##  $ Vinho             : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...
#mostra as variáveis
names(Vinhos)
##  [1] "fixedacidity"       "volatileacidity"    "citricacid"        
##  [4] "residualsugar"      "chlorides"          "freesulfurdioxide" 
##  [7] "totalsulfurdioxide" "density"            "pH"                
## [10] "sulphates"          "alcohol"            "quality"           
## [13] "Vinho"

Descrição das variáveis:

  1. Fixed Acidity: Acidez contida no vinho

  2. Volatile Acidity: Quantidade de ácido acético no vinho, valores altos podem levar o vinho a ter sabor desagradável de vinagre

  3. Citric Acid: Encontrado em pouca quantidade, o ácido cítrico pode adicionar frescor e sabor ao vinho.

  4. Residual Sugar: Quantidade de açucar restante após o término da fermentação. É raro encontrar vinhos com menos de 1 g/l e vinhos com valores maiores que 45 g/l são considerardos doces.

  5. Chlorides: Quantidade de sal no vinho

  6. Free Sulfur Dioxide: A forma livre de SO2 (dióxido de enxofre) existe em equilibrio entre SO2 molecular (como um gás dissolvido) e ions bissulfito. Evita o crescimento de micróbios e oxidação do vinho.

  7. Total Sulfur Dioxide: Total de SO2 livres ou ligados. Em baixa concentração, o SO2 é praticamente imperceptível no vinho, mas em concentrações acima de 50 ppm, o dióxido de enxofre torna-se evidente no aroma e sabor do vinho

  8. Density: A densidade do vinho depende do percentual de álcool e açúcar.

  9. pH: Descreve se o vinho é básico (14) ou ácido (0). A maioria dos vinhos possuem pH entre 3 e 4

  10. Sulphates: Aditivo que pode contribuir com os níveis de SO2, que age contra micróbios e oxidação

  11. Alcohol: O percentual de álcool no vinho

  12. Quality: Qualidade do vinho com pontuação de 0 a 10, sendo 10 muito bom e 0 de péssima qualidade

  13. Vinho: Tipo do vinho: tinto (RED) ou branco (WHITE)

Estatística Descritiva

Sumário dos dados

attach(Vinhos)

summary(Vinhos)
##   fixedacidity    volatileacidity    citricacid     residualsugar  
##  Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.60  
##  1st Qu.: 6.400   1st Qu.:0.2300   1st Qu.:0.2500   1st Qu.: 1.80  
##  Median : 7.000   Median :0.2900   Median :0.3100   Median : 3.00  
##  Mean   : 7.215   Mean   :0.3397   Mean   :0.3186   Mean   : 5.44  
##  3rd Qu.: 7.700   3rd Qu.:0.4000   3rd Qu.:0.3900   3rd Qu.: 8.10  
##  Max.   :15.900   Max.   :1.5800   Max.   :1.6600   Max.   :45.80  
##    chlorides       freesulfurdioxide totalsulfurdioxide    density      
##  Min.   :0.00900   Min.   :  1.00    Min.   :  6.0      Min.   :0.9871  
##  1st Qu.:0.03800   1st Qu.: 17.00    1st Qu.: 77.0      1st Qu.:0.9923  
##  Median :0.04700   Median : 29.00    Median :118.0      Median :0.9949  
##  Mean   :0.05603   Mean   : 30.53    Mean   :115.7      Mean   :0.9947  
##  3rd Qu.:0.06500   3rd Qu.: 41.00    3rd Qu.:156.0      3rd Qu.:0.9970  
##  Max.   :0.61100   Max.   :289.00    Max.   :440.0      Max.   :1.0140  
##        pH          sulphates         alcohol           quality     
##  Min.   :2.720   Min.   :0.2200   Min.   : 0.9567   Min.   :3.000  
##  1st Qu.:3.110   1st Qu.:0.4300   1st Qu.: 9.5000   1st Qu.:5.000  
##  Median :3.210   Median :0.5100   Median :10.3000   Median :6.000  
##  Mean   :3.219   Mean   :0.5313   Mean   :10.4862   Mean   :5.818  
##  3rd Qu.:3.320   3rd Qu.:0.6000   3rd Qu.:11.3000   3rd Qu.:6.000  
##  Max.   :4.010   Max.   :2.0000   Max.   :14.9000   Max.   :9.000  
##    Vinho     
##  RED  :1599  
##  WHITE:4898  
##              
##              
##              
## 

Analisando o sumario, nota-se potenciais outliers dados que os valores mínimos e máximos estão muito distantes dos quartis para as seguintes variáveis: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, sulphates e alcohol

Além disso, há valores muito discrepantes:

  • CitriCAcid com valor mínimo 0
  • TotalSulfurDioxide com valor mínimo 6
  • Alcohol com valor mínimo 0,9667

Frequencia Absoluta

table(as.factor(Vinhos$quality), Vinhos$Vinho, useNA = "ifany")
##    
##      RED WHITE
##   3   10    20
##   4   53   163
##   5  681  1457
##   6  638  2198
##   7  199   880
##   8   18   175
##   9    0     5
plot_ly (
  as.data.frame.matrix ( table(as.factor(Vinhos$quality), Vinhos$Vinho) ), 
  x = c(3:9), y= ~RED, type = 'bar', name='Tinto') %>%
  add_trace(y= ~WHITE, name='Branco') %>%
  layout(barmode = 'group')

Analisando a quantidade de vinhos por tipo e por qualidade, há mais vinhos do tipo branco do que tinto no data set. Também nota-se que ambos vinhos seguem uma tendência normal com relação à qualidade.

Valores estatisticos relevantes para o vinho tinto

describe(Vinhos %>% filter(Vinho=="RED")) %>% select("Mínima"=min, "Máxima"=max, "Média"=mean, "Desvio Padrão"=sd, "Mediana"=median) -> estatTinto
estatTinto

Valores estatisticos relevantes para o vinho branco

describe(Vinhos %>% filter(Vinho=="WHITE")) %>% select("Mínima"=min, "Máxima"=max, "Média"=mean, "Desvio Padrão"=sd, "Mediana"=median) -> estatBranco
estatBranco

Obtem as razões entre as estatísticas

    estatRazao <- estatTinto / estatBranco
    estatRazao



Comparando-se os atributos dos vinhos tintos com os vinhos brancos de forma tabular através da observação dos parâmetros de máximo, mínimo, média, desvio padrão e mediana da amostra. Temos:

  • Quase todos os atributos dos vinhos tem distribuição bem diferentes.
  • Alguns poucos são semelhantes, pode-se citar: density, pH e quality
  • Outros são muito desiguais: residualsugar,freesulfurdioxide,totalsulfurdioxide
  • Para as outras características há diferenças significativas nos parâmetros entre 20% a quase 500%

    Antes de qualquer conclusão, deve-se tratar as questões do outliers e valores faltantes que podem estar influenciando esta amostra.

  • Retirada de valores nulos ou zerados

    #seleciona os vinhos com citricacid zerado 
    vinhosComZero <- which(Vinhos$citricacid == 0)
    print(vinhosComZero)
    ##   [1]    7   17   29   32   35   55   74  155  182  189  235  284  295  308
    ##  [15]  328  336  436  470  618  628  824  882  884  918  979 1012 1061 1079
    ##  [29] 1141 1187 1212 1222 1237 1244 1425 1608 1699 1700 1757 1812 1834 1836
    ##  [43] 1850 1875 1895 1898 1906 1956 2239 2315 2402 2442 2451 2471 2489 2566
    ##  [57] 2578 2652 2668 2724 2843 2878 2902 2906 2921 2966 3002 3078 3117 3220
    ##  [71] 3261 3262 3300 3322 3441 3456 3469 3481 3507 3508 3596 3744 3799 3847
    ##  [85] 3940 3973 3980 4036 4071 4129 4152 4200 4208 4216 4272 4282 4289 4321
    ##  [99] 4394 4397 4512 4517 4534 4547 4549 4604 4704 4712 4768 4769 4814 4864
    ## [113] 4884 4947 4980 5048 5063 5079 5088 5108 5198 5301 5368 5389 5395 5406
    ## [127] 5432 5468 5497 5518 5538 5552 5594 5634 5651 5752 5778 5800 5813 5861
    ## [141] 5881 6013 6029 6077 6109 6256 6309 6394 6436 6451 6458
    #Segundo o site https://vinosdiferentes.com/pt/acidez-do-vinho/
    #O valor do ácido cítrico é bem baixo, entre 0,1 e 1 g / litro 
    #Esse valor zerado pode ter sido a imprecisão dos aparelhos de medição
    #Vamos trocá-los por 0.1 que é o valor mais provável 
    Vinhos[vinhosComZero,"citricacid"] <- 0.1
    
    
    
    #Verifica se há valores faltantes no dataset 
    
    nVinhosComValoresFaltantes <- length(Vinhos[is.na(Vinhos)]) + length(Vinhos[is.nan(as.matrix(Vinhos))])
    paste0("Vinhos com valores faltantes = ",nVinhosComValoresFaltantes)
    ## [1] "Vinhos com valores faltantes = 0"



    Pelos resultados observados de forma tabular, temos que apenas o atributo citricacid possui valores zerados. Conforme pesquisado na Internet (https://vinosdiferentes.com/pt/acidez-do-vinho/) , sabemos que o valor do ácido cítrico deve variar entre 0.1 e 1. Deste modo, muito provavelmente, o valor zerado deve ocorrer por imprecisão dos aparelhos de medição da concentração de ácido cítrico. Fazemos a sua substituição pelo valor mínimo (0.1)

    Quanto a existência de valores inválidos ou não inexistentes, isto não foi detectado na amostra.



    Boxplot das variáveis para visualização de outliers

    attach(Vinhos)
    boxplot(fixedacidity ~ Vinho, main='fixedacidity',col=c('red','blue'))

    boxplot(volatileacidity ~ Vinho , main='volatileacidity')

    boxplot(citricacid ~ Vinho, main='citricacid')

    boxplot(residualsugar ~ Vinho, main='residualsugar',col=c('red','blue'))

    boxplot(chlorides ~ Vinho, main='chlorides')

    boxplot(freesulfurdioxide ~ Vinho, main='freesulfurdioxide')

    boxplot(totalsulfurdioxide ~ Vinho, main='totalsulfurdioxide')

    boxplot(density ~ Vinho, main='density')

    boxplot(pH ~ Vinho, main='pH')

    boxplot(sulphates ~ Vinho, main='sulphates')

    boxplot(alcohol ~ Vinho, main='alcohol')



    Quando realizamos a quebra pelo tipo de vinho em boxplotes, percebemos as seguintes características :

    fixedacidity - O vinho tinto possui potenciais outliers apenas acima da barreira enquanto o branco possui acima e abaixo das barreiras

    citricacid - Há mais potenciais outliers para vinho branco e eles aparecem tanto acima como abaixo das barreiras

    residual sugar - Para vinho tinto há mais ponteciais outliers. Para vinho branco há menos mas ficam mais distantes da barreira superior

    freesulfurdioxide - Há mais potenciais outliers para o vinho branco e se localizam mais distantes da barreira superior.

    totalsufurdioxide - Há potenciais outliers tanto abaixo como acima das barreira para vinhos brancos, para tinto apenas acima e mais próximos

    density - Para tinto há um número maior de potenciais outliers, tanto abaixo como acima das barreiras, para branco há poucos e alguns bem distantes

    sulphates - Para tinto há mais potenciais outliers e mais distantes da barreira superior

    alcohol - Há potenciais outliers acima e abaixo das barreiras apenas para vinhos tintos.





    Dividiu-se a amostra entre Vinhos Tintos e Vinhos Brancos

    A partir dessa divisão, traçaram-se lado a lado os histogramas dessa subdivisão e percebe-se que o histograma é bem diferente para cada atributo e cada tipo de vinho (tinto e branco)

    A percepção visual será complementada com os testes T das médias dos atributos numéricos para a comprovação das diferenças.



    for (atr in atributos_numericos){
      result <- t.test(VinhosTintos[,atr],VinhosBrancos[,atr])
      print(paste0("Teste de igualdade das médias entre tintos e brancos para o atributo ",atr))
      print(result)
      
    }
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo fixedacidity"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = 32.423, df = 1848.9, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  1.376241 1.553458
    ## sample estimates:
    ## mean of x mean of y 
    ##  8.319637  6.854788 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo volatileacidity"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = 53.059, df = 1938.9, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  0.2403544 0.2588044
    ## sample estimates:
    ## mean of x mean of y 
    ## 0.5278205 0.2782411 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo citricacid"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = -11.216, df = 2055.3, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -0.06502621 -0.04567110
    ## sample estimates:
    ## mean of x mean of y 
    ## 0.2792308 0.3345794 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo residualsugar"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = -48.057, df = 6401, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -4.005513 -3.691539
    ## sample estimates:
    ## mean of x mean of y 
    ##  2.538806  6.387332 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo chlorides"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = 34.24, df = 1827.8, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  0.03930596 0.04408241
    ## sample estimates:
    ##  mean of x  mean of y 
    ## 0.08746654 0.04577236 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo freesulfurdioxide"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = -54.428, df = 4461.9, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -20.13315 -18.73318
    ## sample estimates:
    ## mean of x mean of y 
    ##  15.87492  35.30808 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo totalsulfurdioxide"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = -89.872, df = 3477, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -93.89760 -89.88813
    ## sample estimates:
    ## mean of x mean of y 
    ##  46.46779 138.36066 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo density"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = 43.15, df = 4252.3, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  0.002600624 0.002848190
    ## sample estimates:
    ## mean of x mean of y 
    ## 0.9967467 0.9940223 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo pH"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = 27.775, df = 2667.1, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  0.1141740 0.1315191
    ## sample estimates:
    ## mean of x mean of y 
    ##  3.311113  3.188267 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo sulphates"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = 37.056, df = 2091, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  0.159395 0.177209
    ## sample estimates:
    ## mean of x mean of y 
    ## 0.6581488 0.4898469 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo alcohol"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = -3.3571, df = 2852.3, p-value = 0.0007979
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -0.18088842 -0.04749554
    ## sample estimates:
    ## mean of x mean of y 
    ##  10.40008  10.51427 
    ## 
    ## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo quality"
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosTintos[, atr] and VinhosBrancos[, atr]
    ## t = -10.149, df = 2950.8, p-value < 2.2e-16
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -0.2886173 -0.1951564
    ## sample estimates:
    ## mean of x mean of y 
    ##  5.636023  5.877909



    Realizados os testes T para as amostras separadas de vinhos tintos e brancos, observam-se os fatos descritos abaixo:
  • Para cada atributo numérico dos vinhos brancos e tintos realizou-se um teste T
  • Os testes foram parametrizados com uma margem de confiança de 95%
  • O p-value de cada um dos testes apresentou valores substancialmente menores que 5%.

    Deste modo, para o modelo preditivo a ser desenvolvido, a partir deste ponto, iremos separar a amostras entre os dois tipos de vinho (tinto,branco) e prosseguiremos na criação do modelo preditivo da qualidade apenas para os vinhos brancos

  • Tratatamento dos outliers

    #Selecionar e imprimir potenciais outliers, supondo uma distribuição normal.
    #Nesse caso, uma informação é classificada como outlier quando é superior a 1.5 vezes o intervalo interquartil além
    #do 3o. quartil ou inferior a 1.5 vezes o intervalor interquartil abaixo do 1 quartil 
    for (atributo in atributos_numericos){
      outliers <- boxplot.stats(VinhosBrancos[,atributo])$out
      if (length(outliers) > 0 ){
        print(paste0("Potenciais outliers referentes ao atributo ",atributo))
        print(paste0("Quantidade de potenciais outliers ",length(outliers)))
        print("")
        print(outliers)
        print("")
      }
      
    }
    ## [1] "Potenciais outliers referentes ao atributo fixedacidity"
    ## [1] "Quantidade de potenciais outliers 119"
    ## [1] ""
    ##   [1]  9.3  9.1  9.2  9.2  9.2  9.3  9.2  9.8  8.9  9.2  9.2  4.2  9.8 10.3
    ##  [15] 10.2  9.8  9.0 10.0  8.9  8.9  9.2  9.0 10.0  9.0  9.2  9.8  9.0  4.7
    ##  [29]  8.9  4.7 10.7  8.9  9.6  9.2  8.9  8.9  9.0  9.1  9.8  9.2  9.4  9.0
    ##  [43]  9.6  9.0  9.2  9.6  9.3  9.8  9.2  9.0  9.9  4.7  4.4  9.6  8.9  9.8
    ##  [57]  9.9  8.9  9.4  9.2  8.9 10.0  9.0  4.6  9.0  3.8  9.0  9.2  9.0  9.7
    ##  [71]  9.2  9.7 11.8  9.7 14.2  8.9  8.9  9.7  4.7  9.4  9.5  9.4  9.1  9.4
    ##  [85]  9.0  9.0  9.4  9.6  9.0  9.2 10.7  9.8  9.1 10.3  3.9  9.2  4.4  8.9
    ##  [99]  9.4  9.0  9.2  4.4  8.9  4.2  9.5  9.0  9.4  4.7  9.2  9.2  9.1  9.4
    ## [113]  9.4  4.5  8.9  8.9  9.1  9.2  9.4
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo volatileacidity"
    ## [1] "Quantidade de potenciais outliers 186"
    ## [1] ""
    ##   [1] 0.580 0.560 0.510 0.520 0.695 0.670 0.550 0.610 0.640 0.710 0.640
    ##  [12] 0.555 0.540 0.570 0.510 0.520 0.660 0.610 0.595 0.520 0.620 0.580
    ##  [23] 0.490 0.530 0.550 0.520 0.590 0.570 0.510 0.490 0.550 0.560 0.540
    ##  [34] 0.590 0.910 0.660 0.510 0.550 0.640 0.690 0.670 0.510 0.490 0.540
    ##  [45] 0.690 0.580 0.555 0.580 0.600 0.545 0.500 0.610 0.670 0.815 0.650
    ##  [56] 0.530 0.540 0.655 0.600 0.520 0.550 0.560 0.670 0.655 0.500 0.520
    ##  [67] 0.680 0.615 0.490 0.560 0.550 0.490 0.930 0.490 0.685 0.520 0.530
    ##  [78] 0.550 0.760 0.640 0.490 0.560 0.600 0.510 0.580 0.640 0.620 1.005
    ##  [89] 0.560 0.965 0.520 0.500 0.520 0.490 0.560 0.540 0.500 0.530 0.520
    ## [100] 0.640 0.640 0.600 0.530 0.490 0.530 0.695 0.560 0.610 0.500 0.500
    ## [111] 0.730 0.500 0.510 0.660 0.600 0.670 0.580 0.780 0.680 0.630 0.615
    ## [122] 0.530 0.615 0.620 0.500 0.570 0.540 0.490 0.550 0.550 0.500 0.530
    ## [133] 0.550 0.785 0.570 1.100 0.705 0.600 0.850 0.510 0.500 0.600 0.495
    ## [144] 0.620 0.660 0.750 0.540 0.905 0.490 0.550 0.510 0.655 0.585 0.705
    ## [155] 0.680 0.580 0.500 0.540 0.595 0.610 0.540 0.500 0.650 0.610 0.615
    ## [166] 0.740 0.610 0.495 0.550 0.585 0.590 0.760 0.490 0.510 0.695 0.500
    ## [177] 0.620 0.540 0.550 0.490 0.630 0.590 0.550 0.490 0.560 0.500
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo citricacid"
    ## [1] "Quantidade de potenciais outliers 251"
    ## [1] ""
    ##   [1] 0.07 1.00 0.74 0.07 0.09 0.62 0.04 0.07 0.06 0.68 0.59 0.04 0.01 0.07
    ##  [15] 0.71 0.74 0.67 0.02 0.04 0.74 1.00 0.61 0.59 0.64 0.74 0.70 0.58 0.62
    ##  [29] 0.66 0.71 0.88 0.68 0.74 0.04 0.64 0.65 0.01 0.67 0.58 0.62 0.62 0.67
    ##  [43] 0.58 0.72 0.91 0.62 0.71 0.05 0.74 0.58 0.74 0.07 0.05 0.74 0.58 0.72
    ##  [57] 0.65 0.01 0.09 0.09 0.06 0.74 0.72 0.79 0.09 0.08 0.72 0.65 0.81 0.66
    ##  [71] 0.66 0.04 0.74 0.65 0.58 0.05 0.61 0.71 0.58 0.71 0.71 0.09 0.73 0.58
    ##  [85] 0.59 0.74 0.74 0.02 0.82 0.66 0.99 0.74 0.73 0.66 1.66 0.58 0.64 0.74
    ##  [99] 0.79 0.58 0.74 0.71 0.04 0.07 1.00 0.01 0.58 0.74 0.65 0.69 0.01 0.64
    ## [113] 0.67 0.73 0.09 0.60 0.74 0.74 0.74 0.80 0.60 0.60 0.69 0.06 0.01 1.23
    ## [127] 0.74 0.63 0.82 0.78 0.69 0.58 0.74 0.58 0.78 0.60 0.04 0.61 0.73 0.74
    ## [141] 0.65 0.74 0.66 0.65 1.00 0.74 0.61 0.02 0.62 0.61 0.08 0.06 0.68 0.02
    ## [155] 0.07 0.07 0.06 0.62 0.62 0.74 0.69 0.07 0.91 0.02 1.00 0.04 0.70 0.74
    ## [169] 0.59 0.68 0.09 0.74 0.74 0.05 0.61 0.08 0.68 0.02 0.71 0.61 0.62 0.07
    ## [183] 0.67 0.63 0.68 0.62 0.74 0.68 0.58 0.07 0.09 0.74 0.74 0.03 0.69 0.58
    ## [197] 0.60 0.65 0.74 0.81 0.80 0.67 0.58 0.08 0.74 0.62 0.09 0.09 0.04 0.72
    ## [211] 0.61 0.74 0.74 0.09 0.67 0.74 0.01 0.06 0.60 0.73 0.74 0.04 0.64 0.62
    ## [225] 0.63 0.58 0.63 0.04 0.58 0.64 0.74 0.07 0.74 0.59 0.61 0.58 0.74 0.03
    ## [239] 0.66 0.74 0.58 0.71 0.62 0.70 0.59 0.09 0.58 0.86 0.04 0.62 0.05
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo residualsugar"
    ## [1] "Quantidade de potenciais outliers 7"
    ## [1] ""
    ## [1] 26.05 31.60 22.60 45.80 31.60 26.05 23.50
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo chlorides"
    ## [1] "Quantidade de potenciais outliers 208"
    ## [1] ""
    ##   [1] 0.114 0.014 0.074 0.093 0.172 0.171 0.147 0.123 0.083 0.168 0.074
    ##  [12] 0.092 0.075 0.144 0.126 0.115 0.076 0.346 0.076 0.154 0.087 0.096
    ##  [23] 0.160 0.084 0.076 0.169 0.104 0.072 0.093 0.086 0.108 0.009 0.095
    ##  [34] 0.074 0.152 0.212 0.158 0.092 0.079 0.175 0.142 0.077 0.083 0.096
    ##  [45] 0.084 0.185 0.118 0.173 0.170 0.073 0.076 0.167 0.145 0.088 0.201
    ##  [56] 0.117 0.076 0.094 0.200 0.080 0.137 0.168 0.073 0.080 0.105 0.204
    ##  [67] 0.014 0.157 0.150 0.174 0.290 0.076 0.121 0.180 0.152 0.148 0.110
    ##  [78] 0.122 0.084 0.074 0.119 0.133 0.194 0.170 0.094 0.119 0.083 0.098
    ##  [89] 0.102 0.094 0.208 0.099 0.138 0.088 0.117 0.087 0.135 0.176 0.184
    ## [100] 0.185 0.078 0.142 0.120 0.211 0.157 0.092 0.082 0.086 0.080 0.149
    ## [111] 0.208 0.119 0.126 0.123 0.156 0.012 0.244 0.076 0.085 0.110 0.074
    ## [122] 0.239 0.138 0.098 0.110 0.142 0.076 0.072 0.083 0.096 0.121 0.014
    ## [133] 0.096 0.073 0.147 0.168 0.184 0.117 0.126 0.083 0.074 0.123 0.136
    ## [144] 0.085 0.137 0.197 0.074 0.075 0.082 0.074 0.094 0.096 0.081 0.108
    ## [155] 0.079 0.073 0.098 0.112 0.157 0.160 0.079 0.127 0.078 0.201 0.175
    ## [166] 0.169 0.084 0.123 0.087 0.271 0.089 0.255 0.097 0.096 0.176 0.081
    ## [177] 0.132 0.079 0.091 0.240 0.217 0.090 0.086 0.127 0.094 0.073 0.086
    ## [188] 0.076 0.173 0.167 0.179 0.301 0.090 0.209 0.013 0.014 0.197 0.130
    ## [199] 0.157 0.095 0.085 0.093 0.172 0.186 0.084 0.146 0.080 0.174
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo freesulfurdioxide"
    ## [1] "Quantidade de potenciais outliers 50"
    ## [1] ""
    ##  [1] 108.0  81.0  85.0 289.0 101.0 128.0  83.0  81.0  98.0  86.0  97.0
    ## [12]  96.0  86.0  87.0  96.0  87.0  82.5  81.0 122.5 146.5  88.0  82.0
    ## [23]  81.0 105.0  98.0  98.0  82.0 105.0  81.0 112.0 101.0  83.0  81.0
    ## [34] 131.0  83.0 108.0  85.0  87.0  95.0  93.0 124.0 138.5 108.0 110.0
    ## [45]  81.0 118.5  89.0  96.0  87.0  83.0
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo totalsulfurdioxide"
    ## [1] "Quantidade de potenciais outliers 19"
    ## [1] ""
    ##  [1] 440.0   9.0 256.0 260.0  19.0 294.0 307.5 256.0 272.0 259.0  18.0
    ## [12] 303.0  18.0 313.0 344.0  10.0 366.5 272.0 282.0
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo density"
    ## [1] "Quantidade de potenciais outliers 5"
    ## [1] ""
    ## [1] 1.00295 1.01030 1.01398 1.01030 1.00295
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo pH"
    ## [1] "Quantidade de potenciais outliers 75"
    ## [1] ""
    ##  [1] 3.80 3.59 3.57 3.60 3.64 3.63 3.58 2.79 3.82 2.79 3.68 3.65 3.65 3.66
    ## [15] 3.58 3.69 3.61 3.63 3.60 3.69 3.74 3.59 3.81 3.66 3.63 3.60 3.66 3.60
    ## [29] 3.57 3.72 2.80 2.77 3.64 3.57 3.63 3.65 3.63 3.59 3.59 3.66 3.68 2.72
    ## [43] 3.79 3.74 3.75 3.75 3.62 3.59 3.80 2.74 2.79 3.59 3.60 3.61 3.58 3.58
    ## [57] 3.60 3.57 3.77 3.57 3.58 3.72 3.76 3.65 3.72 3.76 3.60 3.66 3.70 3.61
    ## [71] 2.80 3.67 3.77 2.80 3.63
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo sulphates"
    ## [1] "Quantidade de potenciais outliers 124"
    ## [1] ""
    ##   [1] 0.77 0.78 0.78 0.98 0.78 0.79 0.79 0.79 0.86 0.79 0.77 0.82 0.95 0.80
    ##  [15] 0.77 0.79 0.78 0.90 0.88 0.79 0.78 0.78 0.81 0.78 0.78 0.82 0.97 0.78
    ##  [29] 0.78 0.77 0.83 0.81 0.80 0.77 0.88 0.78 0.90 0.79 1.00 0.96 0.82 0.84
    ##  [43] 0.81 0.88 0.82 0.80 0.77 0.98 0.84 0.78 0.79 0.77 0.82 0.88 0.77 0.82
    ##  [57] 0.82 0.98 0.94 0.87 0.82 0.78 0.81 0.79 0.78 0.92 0.82 0.94 0.88 0.88
    ##  [71] 0.79 0.96 0.96 0.77 1.06 0.83 0.85 1.08 0.81 0.95 0.98 0.78 0.79 0.84
    ##  [85] 0.98 0.92 0.80 0.78 0.79 0.90 0.77 0.79 0.86 0.79 0.77 0.82 0.95 0.85
    ##  [99] 0.79 0.77 0.99 0.77 0.95 0.77 0.82 0.77 0.77 0.78 0.89 0.82 0.78 0.80
    ## [113] 1.01 0.82 0.88 0.85 0.98 0.78 0.79 0.95 0.84 0.87 0.90 0.90
    ## [1] ""
    ## [1] "Potenciais outliers referentes ao atributo quality"
    ## [1] "Quantidade de potenciais outliers 200"
    ## [1] ""
    ##   [1] 8 8 8 8 8 9 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 3 8 8 8 8
    ##  [36] 8 3 3 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8
    ##  [71] 8 8 3 8 9 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 3 8 8 3 8 8 8 8 8 3
    ## [106] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 8 8 3
    ## [141] 8 8 8 8 3 8 8 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9
    ## [176] 8 3 8 8 8 8 8 8 8 8 8 8 3 3 8 8 8 3 8 8 8 8 3 8 8
    ## [1] ""



    Há valores potenciais de outliers em quase todos os atributos dos vinhos brancos, exceto na concentração de alchool que não apresenta outliers

    Para verificar se os valores são realmente outliers, sabendo-se que os vinhos são portugueses, utilizou-se os valores de referência do Instituto da Vinha e do Vinho de Portugal, com as informações presentes no link a seguir: http://www.ivv.gov.pt/np4/89/

  • Acidez Total >= 3.5 g/L
  • Acidez Volátil <= 500 mg/L
  • Ácido Cítrico <= 1 g/L
  • 1 g/L <= Açúcar Residual <= 32 g/L
  • Cloretos <= 1 g/L
  • Total Dióxiodo de Enxofre <= 250 mg/L



  • Extração dos outliers

    outAcidezTotal <- which(VinhosBrancos$fixedacidity < 3.5)
    outAcidezVolatil <- which(VinhosBrancos$volatileacidity > 0.5)
    outAcidoCitrico <- which(VinhosBrancos$citricacid > 1.0)
    outAcucar1 <- which(VinhosBrancos$residualsugar > 32)
    outAcucar2 <- which(VinhosBrancos$residualsugar < 1)
    outCloreto <- which(VinhosBrancos$chlorides > 1)
    outTotalSO2 <- which(VinhosBrancos$totalsulfurdioxide > 250)
    
    outVinhoBranco <- unique(c(outAcidezTotal,outAcidezVolatil,outAcidoCitrico,
                               outAcucar1,outAcucar2,outCloreto,outTotalSO2))
    
    
    hist(VinhosBrancos[outVinhoBranco,"quality"],main="Qualidade dos vinhos brancos com outliers ")

    print("Sumário da qualidade dos vinhos Brancos considerados como outliers ")
    ## [1] "Sumário da qualidade dos vinhos Brancos considerados como outliers "
    summary(VinhosBrancos[outVinhoBranco,"quality"])
    ##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    ##   3.000   5.000   5.000   5.284   6.000   8.000
    VinhosBrancosSemOut <- VinhosBrancos[-outVinhoBranco,]
    hist(VinhosBrancosSemOut[,"quality"],main="Qualidade dos vinhos brancos sem outliers ")

    print("Sumário da qualidade dos vinhos Brancos sem outliers")
    ## [1] "Sumário da qualidade dos vinhos Brancos sem outliers"
    summary(VinhosBrancosSemOut[,"quality"])
    ##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    ##    3.00    5.00    6.00    5.91    6.00    9.00
    print("Teste T para a média de qualidade entre os vinhos brancos sem outliers e a amostra completa")
    ## [1] "Teste T para a média de qualidade entre os vinhos brancos sem outliers e a amostra completa"
    print(t.test(VinhosBrancos$quality,VinhosBrancosSemOut$quality))
    ## 
    ##  Welch Two Sample t-test
    ## 
    ## data:  VinhosBrancos$quality and VinhosBrancosSemOut$quality
    ## t = -1.7793, df = 9533.9, p-value = 0.07523
    ## alternative hypothesis: true difference in means is not equal to 0
    ## 95 percent confidence interval:
    ##  -0.067137134  0.003248435
    ## sample estimates:
    ## mean of x mean of y 
    ##  5.877909  5.909854
    VinhosBrancos <- VinhosBrancosSemOut



    Os vinhos brancos selecionados como outliers não possuíam uma distribuição especial em relação à qualidade e não afetavam a média da qualidade dos vinhos. Deste modo, realizou-se um teste T entre os vinhos brancos sem os outliers e a amostra completa, com 95% de confiança e falhou (p-value = 7,5%). Portanto as amostra possuem médias iguais. Por fim, os outliers foram retirados da amostra e do modelo a ser utilizado para predição.



    # Gráfico de dispersão ( pch=caracter, lwd=largura)
    attach(VinhosBrancos)
    ## The following objects are masked from Vinhos (pos = 3):
    ## 
    ##     alcohol, chlorides, citricacid, density, fixedacidity,
    ##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
    ##     totalsulfurdioxide, Vinho, volatileacidity
    ## The following objects are masked from Vinhos (pos = 5):
    ## 
    ##     alcohol, chlorides, citricacid, density, fixedacidity,
    ##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
    ##     totalsulfurdioxide, Vinho, volatileacidity
    #Gráfico de dispersão entre freesulfurdioxide e totalsulfurdioxide 
    plot(freesulfurdioxide~totalsulfurdioxide,pch=1,lwd=3)
    abline(h=mean(freesulfurdioxide), col="red")
    abline(v=mean(totalsulfurdioxide), col="green")



    Pelo gráfico, pode-se notar uma tendência linear entre as duas variáveis pelo formato do gráfico. Neste, pode-se perceber que, normalmente, quanto maior o indicador totalsulfurdioxide tanto maior o indicador freesulfurdioxide. No entanto, o espalhamento ao redor de uma possível reta mostra que pode não ser a aproximação mais adequada

    attach(Vinhos)
    ## The following objects are masked from VinhosBrancos:
    ## 
    ##     alcohol, chlorides, citricacid, density, fixedacidity,
    ##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
    ##     totalsulfurdioxide, Vinho, volatileacidity
    ## The following objects are masked from Vinhos (pos = 4):
    ## 
    ##     alcohol, chlorides, citricacid, density, fixedacidity,
    ##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
    ##     totalsulfurdioxide, Vinho, volatileacidity
    ## The following objects are masked from Vinhos (pos = 6):
    ## 
    ##     alcohol, chlorides, citricacid, density, fixedacidity,
    ##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
    ##     totalsulfurdioxide, Vinho, volatileacidity
    Vinhos$fx_redSugar <- cut(residualsugar,breaks=c(0,10,20,30,max(residualsugar)))  
    CrossTable( Vinhos$fx_redSugar , Vinhos$Vinho) 
    ## 
    ##  
    ##    Cell Contents
    ## |-------------------------|
    ## |                       N |
    ## | Chi-square contribution |
    ## |           N / Row Total |
    ## |           N / Col Total |
    ## |         N / Table Total |
    ## |-------------------------|
    ## 
    ##  
    ## Total Observations in Table:  6497 
    ## 
    ##  
    ##                    | Vinhos$Vinho 
    ## Vinhos$fx_redSugar |       RED |     WHITE | Row Total | 
    ## -------------------|-----------|-----------|-----------|
    ##             (0,10] |      1588 |      3705 |      5293 | 
    ##                    |    62.493 |    20.401 |           | 
    ##                    |     0.300 |     0.700 |     0.815 | 
    ##                    |     0.993 |     0.756 |           | 
    ##                    |     0.244 |     0.570 |           | 
    ## -------------------|-----------|-----------|-----------|
    ##            (10,20] |        11 |      1175 |      1186 | 
    ##                    |   270.305 |    88.244 |           | 
    ##                    |     0.009 |     0.991 |     0.183 | 
    ##                    |     0.007 |     0.240 |           | 
    ##                    |     0.002 |     0.181 |           | 
    ## -------------------|-----------|-----------|-----------|
    ##            (20,30] |         0 |        15 |        15 | 
    ##                    |     3.692 |     1.205 |           | 
    ##                    |     0.000 |     1.000 |     0.002 | 
    ##                    |     0.000 |     0.003 |           | 
    ##                    |     0.000 |     0.002 |           | 
    ## -------------------|-----------|-----------|-----------|
    ##          (30,45.8] |         0 |         3 |         3 | 
    ##                    |     0.738 |     0.241 |           | 
    ##                    |     0.000 |     1.000 |     0.000 | 
    ##                    |     0.000 |     0.001 |           | 
    ##                    |     0.000 |     0.000 |           | 
    ## -------------------|-----------|-----------|-----------|
    ##       Column Total |      1599 |      4898 |      6497 | 
    ##                    |     0.246 |     0.754 |           | 
    ## -------------------|-----------|-----------|-----------|
    ## 
    ## 



    Através da análise acima, pode-se verificar que que a quantidade de açúcar restante nos vinhos tintos é muito menor, sendo que 99,3% destes vinhos tem até 10 g/l e apenas 0,7% possuem quantidade até 20g/l. No caso dos vinhos brancos, percebe-se 75,6% possuem até 10g/l de quantidade de açúcar restante, 24% até 20g/l, 0,3% até 30g/l e 0,1% até 45.8g/l

    Por esta tabela, pode-se deduzir que os vinhos brancos são normalmente percebidos como mais doces que os vinhos tintos.

    #Gráfico da qualidade x concentração residual de açúcar
    
    
    
    plot(quality~residualsugar,data=VinhosBrancos,main="qualidade x residualsugar para vinhos brancos")



    Aqui traçou-se um gráfico para a quantidade residual de açúcar x qualidade para os vinhos brancos já sem os outliers. Percebe-se que os vinhos brancos de maior qualidade possuem uma concentração de açúcar menor que 20 g/L

    ##                    fixedacidity volatileacidity citricacid residualsugar
    ## fixedacidity             1.0000         -0.0351      0.282         0.079
    ## volatileacidity         -0.0351          1.0000     -0.089         0.072
    ## citricacid               0.2824         -0.0894      1.000         0.077
    ## residualsugar            0.0789          0.0724      0.077         1.000
    ## chlorides                0.0095          0.0461      0.128         0.076
    ## freesulfurdioxide       -0.0559         -0.0715      0.091         0.318
    ## totalsulfurdioxide       0.0732          0.1110      0.102         0.402
    ## density                  0.2602         -0.0013      0.145         0.836
    ## pH                      -0.4122         -0.0541     -0.156        -0.200
    ## sulphates               -0.0217         -0.0405      0.053        -0.052
    ## alcohol                 -0.1208          0.0896     -0.092        -0.470
    ## quality                 -0.1118         -0.1388     -0.043        -0.119
    ##                    chlorides freesulfurdioxide totalsulfurdioxide density
    ## fixedacidity          0.0095           -0.0559              0.073  0.2602
    ## volatileacidity       0.0461           -0.0715              0.111 -0.0013
    ## citricacid            0.1279            0.0914              0.102  0.1449
    ## residualsugar         0.0763            0.3183              0.402  0.8360
    ## chlorides             1.0000            0.1178              0.184  0.2501
    ## freesulfurdioxide     0.1178            1.0000              0.614  0.3188
    ## totalsulfurdioxide    0.1842            0.6139              1.000  0.5421
    ## density               0.2501            0.3188              0.542  1.0000
    ## pH                   -0.0825           -0.0062              0.010 -0.0959
    ## sulphates            -0.0010            0.0473              0.108  0.0566
    ## alcohol              -0.3629           -0.2662             -0.465 -0.8080
    ## quality              -0.2074            0.0081             -0.181 -0.3261
    ##                         pH sulphates alcohol quality
    ## fixedacidity       -0.4122    -0.022  -0.121 -0.1118
    ## volatileacidity    -0.0541    -0.040   0.090 -0.1388
    ## citricacid         -0.1562     0.053  -0.092 -0.0431
    ## residualsugar      -0.1995    -0.052  -0.470 -0.1189
    ## chlorides          -0.0825    -0.001  -0.363 -0.2074
    ## freesulfurdioxide  -0.0062     0.047  -0.266  0.0081
    ## totalsulfurdioxide  0.0103     0.108  -0.465 -0.1813
    ## density            -0.0959     0.057  -0.808 -0.3261
    ## pH                  1.0000     0.163   0.125  0.1063
    ## sulphates           0.1627     1.000  -0.019  0.0438
    ## alcohol             0.1246    -0.019   1.000  0.4409
    ## quality             0.1063     0.044   0.441  1.0000



    Pelos gráficos acima, percebe-se:
  • Alta correlação positiva entre a densidade e a concentração residual de açúcar
  • Alta correlação positiva entre Total de SO2 e a taxa de SO2 livre
  • Alta correlação negativa entre o volume de alcool e a densidade

  • ## Warning: package 'factoextra' was built under R version 3.5.1
    ## Welcome! Related Books: `Practical Guide To Cluster Analysis in R` at https://goo.gl/13EFCZ
    ## [1] "Variância acumulada para cada componente "
    ##        eigenvalue variance.percent cumulative.variance.percent
    ## Dim.1  3.38909993       28.2424994                    28.24250
    ## Dim.2  1.58636636       13.2197197                    41.46222
    ## Dim.3  1.26219318       10.5182765                    51.98050
    ## Dim.4  1.12079756        9.3399797                    61.32048
    ## Dim.5  1.00233483        8.3527902                    69.67327
    ## Dim.6  0.95095122        7.9245935                    77.59786
    ## Dim.7  0.74903989        6.2419991                    83.83986
    ## Dim.8  0.73434715        6.1195596                    89.95942
    ## Dim.9  0.57112284        4.7593570                    94.71877
    ## Dim.10 0.34436192        2.8696826                    97.58846
    ## Dim.11 0.27531840        2.2943200                    99.88278
    ## Dim.12 0.01406673        0.1172227                   100.00000
    ## [1] "Percentual que cada componente contribui para explicar a variância "



    Analisando-se o PCA do modelo completo sobre vinhos brancos, percebe-se:
  • Não há um componente que sozinho contribua com mais do que 29% da variância
  • Para conter mais do que 80% da variância há a necessidade de ao menos 7 componentes, o que implicaria em existir ao menos 7 atributos. Pelo gráfico de contribuição dos atributos em relação ao PCA, temos:
  • Percebe-se grupos com contribuições no mesmo quadrante e outros no oposto para cada um dos quadrantes
  • fixedacidity,citricacid,chlorides,volatileacidity contribuem no mesmo sentido. Havendo melhor alinhamento entre fixedacidity e citricacid.
  • residualsugar,density,totalsulfurdioxide,freesulfurdioxide,sulphates estão no mesmo quadrante. Havendo maior proximidade entre residualsugar e density, entre totalsulfurdioxide e freesulfurdioxide.
  • ph,quality estão no mesmo quadrante
  • alcohol está isolado no último quadrante, no entanto, está quase alinhado com residualsugar e density.

    A partir dessas proximidades entre os atributos, analisa-se os componentes PCA para um subgrupo de atributos percebidos no gráfico.

  • # componentes principais - básico
    library(dplyr)
    
    VinhosBrancosNum %>% select(totalsulfurdioxide,freesulfurdioxide) -> df 
    pca2 <- princomp(df, cor=TRUE)
    print(get_eig(pca2))
    ##       eigenvalue variance.percent cumulative.variance.percent
    ## Dim.1  1.6139443         80.69721                    80.69721
    ## Dim.2  0.3860557         19.30279                   100.00000
    VinhosBrancosNum %>% select(density,residualsugar,alcohol) -> df2 
    pca3 <- princomp(df2, cor=TRUE)
    print(get_eig(pca3))
    ##       eigenvalue variance.percent cumulative.variance.percent
    ## Dim.1 2.42132004        80.710668                    80.71067
    ## Dim.2 0.53003882        17.667961                    98.37863
    ## Dim.3 0.04864113         1.621371                   100.00000
    VinhosBrancosNum$contribso2 = VinhosBrancosNum$totalsulfurdioxide *  pca2$loadings[,"Comp.1"][1] + VinhosBrancosNum$freesulfurdioxide *  pca2$loadings[,"Comp.1"][2]
    
    
    VinhosBrancosNum$acucaralcool = VinhosBrancosNum$density * pca3$loadings[,"Comp.1"][1] + 
                                    VinhosBrancosNum$residualsugar * pca3$loadings[,"Comp.1"][2] + 
                                    VinhosBrancosNum$alcohol * pca3$loadings[,"Comp.1"][3]
    
    
    VinhosBrancosModelo <- VinhosBrancosNum
    VinhosBrancosModelo$residualsugar <- NULL
    VinhosBrancosModelo$freesulfurdioxide <- NULL
    VinhosBrancosModelo$totalsulfurdioxide <- NULL
    VinhosBrancosModelo$density <- NULL
    VinhosBrancosModelo$alcohol <- NULL 



    Utilizando-se a informação sobre as correlações entre as variáveis, extraiu-se os componentes PCA não mais do modelo completo, mas sim de alguns atributos Deste modo, calculou-se o PCA para os atributos totalsulfurdioxide e freesulfurdioxide e para os atributos density, totalresidualsugar e alcohol. Feito isto, analisou-se o percentual que cada componente contribuia na variância e, ambos os casos, o primeiro componente tinha um percentual superior a 80%. Mediante a constatação, criaram-se dois novos atributos no modelo:
  • contribso2: para conter a relação linear proposta pelo primeiro componente entre os atributos totalsulfurdioxide e freesulfurdioxide.
  • acucaralcool:para conter a relação linear proposta pelo primeiro componente entre os atributos density,alcohol e residualsugar. Por fim, os atributos originais foram excluídos do modelo por serem passíveis de substituição sem grandes prejuízos.

  • library(lattice)
    ## Warning: package 'lattice' was built under R version 3.5.1
    ## 
    ## Attaching package: 'lattice'
    ## The following object is masked from 'package:corrgram':
    ## 
    ##     panel.fill
    library(latticeExtra)
    ## Warning: package 'latticeExtra' was built under R version 3.5.1
    ## Loading required package: RColorBrewer
    ## 
    ## Attaching package: 'latticeExtra'
    ## The following object is masked from 'package:corrgram':
    ## 
    ##     panel.ellipse
    ## The following object is masked from 'package:ggplot2':
    ## 
    ##     layer
    library(asbio)
    ## Warning: package 'asbio' was built under R version 3.5.1
    ## Loading required package: tcltk
    ## 
    ## Attaching package: 'asbio'
    ## The following object is masked from 'package:psych':
    ## 
    ##     skew
    library(car)
    ## Warning: package 'car' was built under R version 3.5.1
    ## Loading required package: carData
    ## 
    ## Attaching package: 'car'
    ## The following object is masked from 'package:dplyr':
    ## 
    ##     recode
    ## The following object is masked from 'package:psych':
    ## 
    ##     logit
    attach(VinhosBrancosModelo)
    ## The following objects are masked from Vinhos (pos = 11):
    ## 
    ##     chlorides, citricacid, fixedacidity, pH, quality, sulphates,
    ##     volatileacidity
    ## The following objects are masked from VinhosBrancos:
    ## 
    ##     chlorides, citricacid, fixedacidity, pH, quality, sulphates,
    ##     volatileacidity
    ## The following objects are masked from Vinhos (pos = 13):
    ## 
    ##     chlorides, citricacid, fixedacidity, pH, quality, sulphates,
    ##     volatileacidity
    ## The following objects are masked from Vinhos (pos = 15):
    ## 
    ##     chlorides, citricacid, fixedacidity, pH, quality, sulphates,
    ##     volatileacidity
    # Modelo de regressão linear simples
    
    modelo0 <- lm(quality ~ fixedacidity+volatileacidity+citricacid+chlorides+pH+sulphates+contribso2+acucaralcool)
    summary(modelo0)
    ## 
    ## Call:
    ## lm(formula = quality ~ fixedacidity + volatileacidity + citricacid + 
    ##     chlorides + pH + sulphates + contribso2 + acucaralcool)
    ## 
    ## Residuals:
    ##     Min      1Q  Median      3Q     Max 
    ## -3.3198 -0.6292 -0.0144  0.4788  3.3173 
    ## 
    ## Coefficients:
    ##                   Estimate Std. Error t value Pr(>|t|)    
    ## (Intercept)      6.9245191  0.3533119  19.599  < 2e-16 ***
    ## fixedacidity    -0.1010699  0.0165402  -6.111 1.07e-09 ***
    ## volatileacidity -1.3358712  0.1537469  -8.689  < 2e-16 ***
    ## citricacid       0.0919896  0.1116567   0.824   0.4101    
    ## chlorides       -7.2286755  0.5940102 -12.169  < 2e-16 ***
    ## pH               0.0823014  0.0915853   0.899   0.3689    
    ## sulphates        0.2401085  0.1090720   2.201   0.0278 *  
    ## contribso2      -0.0008493  0.0003785  -2.244   0.0249 *  
    ## acucaralcool    -0.0385296  0.0044840  -8.593  < 2e-16 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## Residual standard error: 0.8249 on 4639 degrees of freedom
    ## Multiple R-squared:  0.09899,    Adjusted R-squared:  0.09744 
    ## F-statistic: 63.71 on 8 and 4639 DF,  p-value: < 2.2e-16
    #modelo1 <- lm(Valor ~ Área+Semruído+IA)
    #summary(modelo1)
    #modelo2 <- lm(Valor ~ Área+Semruído+IA+Andar+Suítes+DistBM+AV200m+Vista)
    #summary(modelo2)
    
    
    
    measures <- function(x) {
      L <- list(npar = length(coef(x)),
                dfres = df.residual(x),
                nobs = length(fitted(x)),
                RMSE = summary(x)$sigma,
                R2 = summary(x)$r.squared,
                R2adj = summary(x)$adj.r.squared,
                PRESS = press(x),
                logLik = logLik(x),
                AIC = AIC(x),
                BIC = BIC(x))
      unlist(L)
    }
    
    modl <- list(m1 = modelo0)
    round(t(sapply(modl, measures)), 3)
    ##    npar dfres nobs  RMSE    R2 R2adj    PRESS    logLik      AIC      BIC
    ## m1    9  4639 4648 0.825 0.099 0.097 3169.323 -5695.847 11411.69 11476.14
    # Modelo final.
    modelo_fim <- modelo0
    summary(modelo_fim)
    ## 
    ## Call:
    ## lm(formula = quality ~ fixedacidity + volatileacidity + citricacid + 
    ##     chlorides + pH + sulphates + contribso2 + acucaralcool)
    ## 
    ## Residuals:
    ##     Min      1Q  Median      3Q     Max 
    ## -3.3198 -0.6292 -0.0144  0.4788  3.3173 
    ## 
    ## Coefficients:
    ##                   Estimate Std. Error t value Pr(>|t|)    
    ## (Intercept)      6.9245191  0.3533119  19.599  < 2e-16 ***
    ## fixedacidity    -0.1010699  0.0165402  -6.111 1.07e-09 ***
    ## volatileacidity -1.3358712  0.1537469  -8.689  < 2e-16 ***
    ## citricacid       0.0919896  0.1116567   0.824   0.4101    
    ## chlorides       -7.2286755  0.5940102 -12.169  < 2e-16 ***
    ## pH               0.0823014  0.0915853   0.899   0.3689    
    ## sulphates        0.2401085  0.1090720   2.201   0.0278 *  
    ## contribso2      -0.0008493  0.0003785  -2.244   0.0249 *  
    ## acucaralcool    -0.0385296  0.0044840  -8.593  < 2e-16 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## Residual standard error: 0.8249 on 4639 degrees of freedom
    ## Multiple R-squared:  0.09899,    Adjusted R-squared:  0.09744 
    ## F-statistic: 63.71 on 8 and 4639 DF,  p-value: < 2.2e-16
    Val_pred <- predict(modelo_fim,interval = "prediction", level = 0.95) 
    ## Warning in predict.lm(modelo_fim, interval = "prediction", level = 0.95): predictions on current data refer to _future_ responses
    # intervalo de confianca - grafico para media
    fit <- Val_pred[,1] # valores preditos
    lower <- Val_pred[,2] # limite inferior
    upper <- Val_pred[,3] # limite superior
    
    
    mse <- mean((quality - fit)^2)
    sqrt(mse)
    ## [1] 0.8240714
    erro_usando_media <- mean((quality - mean(quality))^2)
    sqrt(erro_usando_media)
    ## [1] 0.8681628
    # grafico residuo
    rs <- resid(modelo_fim)
    plot(predict(modelo_fim), rs, xlab = "Preditor linear",ylab = "Residuos")
    abline(h = 0, lty = 2)

    CÓDIGO AINDA NÃO FINALIZADO…. PEGO DO EXERCICIO DE BASE DE IMOVIES

    forward<-step(modelo1,direction=“forward”)

    forward

    summary(forward)

    backward<-step(modelo1,direction=“backward”) backward summary(backward)

    stepwise<-step(modelo1,direction=“both”)

    stepwise summary(stepwise)

    Modelo final.

    modelo_fim <- lm(Valor ~ Área+IA+Andar+Suítes+DistBM+Semruído+Vista) summary(modelo_fim)

    Val_pred <- predict(modelo_fim,interval = “prediction”, level = 0.95) fix(Val_pred) # intervalo de confianca - grafico para media fit <- Val_pred[,1] # valores preditos lower <- Val_pred[,2] # limite inferior upper <- Val_pred[,3] # limite superior

    mse <- mean((imoveis$Valor - fit)^2) sqrt(mse)

    erro_usando_media <- mean((imoveis\(Valor - mean(imoveis\)Valor))^2) sqrt(erro_usando_media)

    grafico residuo

    rs <- resid(modelo_fim) plot(predict(modelo_fim), rs, xlab = “Preditor linear”,ylab = “Residuos”) abline(h = 0, lty = 2)

    attach(imoveis) Imoveis_Final<-cbind(imoveis,Val_pred)

    fix(Imoveis_Final)

    write.table(file=‘Arquivo_Valorizacao_Ambiental_saida.csv’,Imoveis_Final, sep=‘;’,dec=‘,’)

    Árvore de Regressão

    install.packages(“rpart”) install.packages(“rpart.plot”) library(rpart) library(rpart.plot)

    modelo_Valor_tree <- rpart (Valor ~ Área+IA+Andar+Suítes+DistBM+Semruído+AV200m+Vista, data=imoveis, cp = 0.001,minsplit = 5,maxdepth=10)

    Faz o Gráfico

    rpart.plot(modelo_Valor_tree, type=4, extra=1, under=FALSE, clip.right.labs=TRUE, fallen.leaves=FALSE, digits=2, varlen=-10, faclen=20, cex=0.4, tweak=1.7, compress=TRUE, snip=FALSE)

    Val_pred_tree <- predict(modelo_Valor_tree,interval = “prediction”, level = 0.95) str(Val_pred_tree)

    mse_tree <- mean((imoveis$Valor - Val_pred_tree)^2) sqrt(mse_tree)

    erro_usando_media <- mean((imoveis\(Valor - mean(imoveis\)Valor))^2) sqrt(erro_usando_media)

    grafico residuo

    rs <- Val_pred_tree- imoveis$Valor plot(predict(modelo_Valor_tree), rs, xlab = “Com Árvore de Regressão”,ylab = “Residuos”) abline(h = 0, lty = 2)

    library(rpart)
    ## Warning: package 'rpart' was built under R version 3.5.1
    library(rpart.plot)
    ## Warning: package 'rpart.plot' was built under R version 3.5.1
    ## 
    ## Attaching package: 'rpart.plot'
    ## The following object is masked from 'package:asbio':
    ## 
    ##     prp
    modelo_Valor_tree <- rpart (quality ~ fixedacidity+volatileacidity+citricacid+chlorides+pH+
                                          sulphates+contribso2+acucaralcool, data=VinhosBrancosModelo, 
                                cp = 0.001,minsplit = 5,maxdepth=10)
    
    
    
    
    # Faz o Gráfico
    rpart.plot(modelo_Valor_tree, type=4, extra=1, under=FALSE, clip.right.labs=TRUE,
               fallen.leaves=FALSE,   digits=2, varlen=-10, faclen=20,
               cex=0.4, tweak=1.7,
               compress=TRUE,
               snip=FALSE)
    ## Warning: labs do not fit even at cex 0.15, there may be some overplotting
    ## Warning: cex and tweak both specified, applying both

    Val_pred_tree <- predict(modelo_Valor_tree,interval = "prediction", level = 0.95) 
    str(Val_pred_tree)
    ##  Named num [1:4648] 6.02 6.44 5.84 5.2 6.74 ...
    ##  - attr(*, "names")= chr [1:4648] "1" "2" "4" "5" ...
    mse_tree <- mean((VinhosBrancosModelo$quality - Val_pred_tree)^2)
    sqrt(mse_tree)
    ## [1] 0.6573595
    erro_usando_media <- mean((VinhosBrancosModelo$quality - mean(VinhosBrancosModelo$quality))^2)
    sqrt(erro_usando_media)
    ## [1] 0.8681628
    # grafico residuo
    rs <- Val_pred_tree- VinhosBrancosModelo$quality
    plot(predict(modelo_Valor_tree), rs, xlab = "Com Árvore de Regressão",ylab = "Residuos")
    abline(h = 0, lty = 2)

    ## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was
    ## done
    ## Warning in principal(VinhosBrancosNum, 3, rotate = "varimax"): The matrix
    ## is not positive semi-definite, scores found from Structure loadings
    ## 
    ## Loadings:
    ##                    RC1    RC2    RC3   
    ## residualsugar       0.871  0.125 -0.056
    ## density             0.921  0.236  0.097
    ## alcohol            -0.764 -0.211 -0.112
    ## acucaralcool        0.931  0.155 -0.026
    ## freesulfurdioxide   0.196  0.821  0.015
    ## totalsulfurdioxide  0.412  0.812  0.047
    ## contribso2          0.381  0.887  0.042
    ## fixedacidity        0.150 -0.094  0.780
    ## citricacid                 0.180  0.679
    ## pH                 -0.251  0.227 -0.616
    ## volatileacidity     0.137 -0.089 -0.179
    ## chlorides           0.262  0.131  0.181
    ## sulphates          -0.146  0.316       
    ## quality            -0.444  0.096 -0.121
    ## 
    ##                  RC1   RC2   RC3
    ## SS loadings    3.803 2.486 1.558
    ## Proportion Var 0.272 0.178 0.111
    ## Cumulative Var 0.272 0.449 0.561

    ## integer(0)